home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / DDPLUS63.ZIP;1 / DDFOSSIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-07-03  |  6.2 KB  |  330 lines
  1.  
  2.  
  3. unit ddfossil;
  4. {$S-,V-,R-}
  5.  
  6. interface
  7. uses dos;
  8.  
  9. type
  10.  fossildatatype = record
  11.                    strsize: word;
  12.                    majver: byte;
  13.                    minver: byte;
  14.                    ident: pointer;
  15.                    ibufr: word;
  16.                    ifree: word;
  17.                    obufr: word;
  18.                    ofree: word;
  19.                    swidth: byte;
  20.                    sheight: byte;
  21.                    baud: byte;
  22.                   end;
  23. var
  24.  port_num: integer;
  25.  fossildata: fossildatatype;
  26.  
  27. procedure async_send(ch: char);
  28. procedure async_send_string(s: string);
  29. function async_receive(var ch: char): boolean;
  30. function async_carrier_drop: boolean;
  31. function async_carrier_present : boolean;
  32. function async_buffer_check: boolean;
  33. function async_init_fossil: boolean;
  34. procedure async_deinit_fossil;
  35. procedure async_flush_output;
  36. procedure async_purge_output;
  37. procedure async_purge_input;
  38. procedure async_set_dtr(state: boolean);
  39. procedure async_watchdog_on;
  40. procedure async_watchdog_off;
  41. procedure async_warm_reboot;
  42. procedure async_cold_reboot;
  43. procedure async_set_baud(n: longint);
  44. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  45. procedure async_set_x00_ext (n: longint);
  46. procedure async_reset_x00_ext;
  47. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
  48.  
  49. implementation
  50.  
  51. procedure async_send(ch: char);
  52. var
  53.  regs: registers;
  54. begin;
  55.  regs.al:=ord(ch);
  56.  regs.dx:=port_num;
  57.  regs.ah:=$01;
  58.  intr($14,regs);
  59. end;
  60.  
  61. procedure async_send_string(s: string);
  62. var
  63.  a: integer;
  64. begin;
  65.  for a:=1 to length(s) do async_send(s[a]);
  66. end;
  67.  
  68. function async_receive(var ch: char): boolean;
  69. var
  70.  regs: registers;
  71. begin;
  72.  ch:=#0;
  73.  regs.ah:=$03;
  74.  regs.dx:=port_num;
  75.  intr($14,regs);
  76.  if (regs.ah and 1)=1 then begin;
  77.   regs.ah:=$02;
  78.   regs.dx:=port_num;
  79.   intr($14,regs);
  80.   ch:=chr(regs.al);
  81.   async_receive:=true;
  82.  end else async_receive:=false;
  83. end;
  84.  
  85. function async_carrier_drop: boolean;
  86. var
  87.  regs: registers;
  88. begin;
  89.  regs.ah:=$03;
  90.  regs.dx:=port_num;
  91.  intr($14,regs);
  92.  if (regs.al and $80)<>0 then async_carrier_drop:=false else async_carrier_drop:=true;
  93. end;
  94.  
  95. function async_carrier_present: boolean;
  96. var
  97.  regs: registers;
  98. begin;
  99.  regs.ah:=$03;
  100.  regs.dx:=port_num;
  101.  intr($14,regs);
  102.  if (regs.al and $80)<>0 then async_carrier_present:=true else async_carrier_present:=false;
  103. end;
  104.  
  105. function async_buffer_check: boolean;
  106. var
  107.  regs: registers;
  108. begin;
  109.  regs.ah:=$03;
  110.  regs.dx:=port_num;
  111.  intr($14,regs);
  112.  if (regs.ah and 1)=1 then async_buffer_check:=true else async_buffer_check:=false;
  113. end;
  114.  
  115. function async_init_fossil: boolean;
  116. var
  117.  regs: registers;
  118. begin;
  119.  regs.ah:=$04;
  120.  regs.bx:=$00;
  121.  regs.dx:=port_num;
  122.  intr($14,regs);
  123.  if regs.ax=$1954 then async_init_fossil:=true else async_init_fossil:=false;
  124. end;
  125.  
  126. procedure async_deinit_fossil;
  127. var
  128.  regs: registers;
  129. begin;
  130.  regs.ah:=$05;
  131.  regs.dx:=port_num;
  132.  intr($14,regs);
  133. end;
  134.  
  135. procedure async_set_dtr(state: boolean);
  136. var
  137.  regs: registers;
  138. begin;
  139.  regs.ah:=$06;
  140.  if state then regs.al:=1 else regs.al:=0;
  141.  regs.dx:=port_num;
  142.  intr($14,regs);
  143. end;
  144.  
  145. procedure async_flush_output;
  146. var
  147.  regs: registers;
  148. begin;
  149.  regs.ah:=$08;
  150.  regs.dx:=port_num;
  151.  intr($14,regs);
  152. end;
  153.  
  154. procedure async_purge_output;
  155. var
  156.  regs: registers;
  157. begin;
  158.  regs.ah:=$09;
  159.  regs.dx:=port_num;
  160.  intr($14,regs);
  161. end;
  162.  
  163. procedure async_purge_input;
  164. var
  165.  regs: registers;
  166. begin;
  167.  regs.ah:=$0A;
  168.  regs.dx:=port_num;
  169.  intr($14,regs);
  170. end;
  171.  
  172. procedure async_watchdog_on;
  173. var
  174.  regs: registers;
  175. begin;
  176.  regs.ah:=$14;
  177.  regs.al:=$01;
  178.  regs.dx:=port_num;
  179.  intr($14,regs);
  180. end;
  181.  
  182. procedure async_watchdog_off;
  183. var
  184.  regs: registers;
  185. begin;
  186.  regs.ah:=$14;
  187.  regs.al:=$00;
  188.  regs.dx:=port_num;
  189.  intr($14,regs);
  190. end;
  191.  
  192. procedure async_warm_reboot;
  193. var
  194.  regs: registers;
  195. begin;
  196.  regs.ah:=$17;
  197.  regs.al:=$01;
  198.  intr($14,regs);
  199. end;
  200.  
  201. procedure async_cold_reboot;
  202. var
  203.  regs: registers;
  204. begin;
  205.  regs.ah:=$17;
  206.  regs.al:=$00;
  207.  intr($14,regs);
  208. end;
  209.  
  210. procedure async_set_baud(n: longint);
  211. var
  212.  w : word;
  213.  regs: registers;
  214. begin;
  215.  regs.ah:=$00;
  216.  regs.al:=$03;
  217.  regs.dx:=port_num;
  218.  w := n;
  219.  If n < 65536 then
  220.    case w of
  221.      300  : regs.al:=regs.al or $40;
  222.      600  : regs.al:=regs.al or $60;
  223.      1200 : regs.al:=regs.al or $80;
  224.      2400 : regs.al:=regs.al or $A0;
  225.      4800 : regs.al:=regs.al or $C0;
  226.      9600 : regs.al:=regs.al or $E0;
  227.      19200: regs.al:=regs.al or $00;
  228.      38400: regs.al:=regs.al or $20;
  229.      57600: regs.al:=regs.al or $40;
  230.    end
  231.  else
  232.  If n = 76800 then
  233.    regs.al:=regs.al or $60
  234.  else
  235.  If n = 115200 then
  236.    regs.al:=regs.al or $80;
  237.  
  238.  intr($14,regs);
  239. end;
  240.  
  241. procedure async_set_flow(SoftTran,Hard,SoftRecv: boolean);
  242. var
  243.  regs: registers;
  244. begin;
  245.  regs.ah:=$0F;
  246.  regs.al:=$00;
  247.  if softtran then regs.al:=regs.al or $01;
  248.  if Hard then regs.al:=regs.al or $02;
  249.  if SoftRecv then regs.al:=regs.al or $08;
  250.  regs.al:=regs.al or $F0;
  251.  Intr($14,regs);
  252. end;
  253.  
  254. procedure async_get_fossil_data;
  255. var
  256.  regs: registers;
  257. begin;
  258.  regs.ah:=$1B;
  259.  regs.cx:=sizeof(fossildata);
  260.  regs.dx:=port_num;
  261.  regs.es:=seg(fossildata);
  262.  regs.di:=ofs(fossildata);
  263.  intr($14,regs);
  264. end;
  265.  
  266. procedure async_set_x00_ext (n: longint);
  267. var
  268.  w : word;
  269.  regs: registers;
  270. begin;
  271.  with regs do
  272.    begin
  273.      ah:=$1E;
  274.      al:=$00;
  275.      bh:=$00;
  276.      bl:=$00;
  277.      ch:=$03;
  278.      dx:=port_num;
  279.    end;
  280.  w := n;
  281.  If n < 65536 then
  282.    case w of
  283.      300  : regs.cl:=$02;
  284.      600  : regs.cl:=$03;
  285.      1200 : regs.cl:=$04;
  286.      2400 : regs.cl:=$05;
  287.      4800 : regs.cl:=$06;
  288.      9600 : regs.cl:=$07;
  289.      19200: regs.cl:=$08;
  290.      38400: regs.cl:=$81;
  291.      57600: regs.cl:=$82;
  292.    end
  293.  else
  294.  If n = 76800 then
  295.    regs.cl:=$83
  296.  else
  297.  If n = 115200 then
  298.    regs.cl:=$84;
  299.  intr($14,regs);
  300. end;
  301.  
  302. procedure async_reset_x00_ext;
  303. var
  304.  w : word;
  305.  regs: registers;
  306. begin;
  307.  with regs do
  308.    begin
  309.      ah:=$1E;
  310.      al:=$00;
  311.      bh:=$00;
  312.      bl:=$00;
  313.      ch:=$03;
  314.      cl:=$FF;
  315.      dx:=port_num;
  316.    end;
  317.  intr($14,regs);
  318. end;
  319.  
  320. procedure Async_Buffer_Status(var Insize,Infree,OutSize,Outfree: word);
  321. begin;
  322.  async_get_fossil_data;
  323.  insize:=fossildata.ibufr;
  324.  infree:=fossildata.ifree;
  325.  outsize:=fossildata.obufr;
  326.  outfree:=fossildata.ofree;
  327. end;
  328.  
  329. end.
  330.